#Dependencies
require(XML)

setClass("multilingual_string",
    contains="vector",
)

#Description : Prints a multilingual string in a specific language, if no language is given defaults to 'en'
#Input       : x = multilingual string, lang=language
#Output      : string
print.multilingual_string <- function(x, lang="en", ...) {
    if (is.na(match(lang,labels(x)))==TRUE) {
       a <- paste("No value found for language ",lang,".", sep='"') 
    } else{
       a <- paste(x[[lang]])
    }
    a
}

#Description : Shortened internal alias for print.multilingual_string
pms <- function(x,...) {
    print.multilingual_string(x,...)
}

setMethod("print", "multilingual_string", print.multilingual_string )
setMethod("toString", "multilingual_string", print.multilingual_string )
    

#Class for generic info
setClass("dspl_info",
    representation(
        name="vector",
        description="vector",
        url="vector",
        others="vector"
    ),
    prototype(
        description=c(en="No Description Available"),
        url=c(en="http://example.com"),
        others=c(NA)
    )
)

#Description : Prints a dspl object 
#Input       : 
#Output      : 
print.dspl_info <- function(x, terse=TRUE,...) {
    cat("Name", pms(x@name,...),sep = " : ")
    cat("\n")
    cat("Description",pms(x@description,...),sep = " : ")
    cat("\n")
    cat("URL",pms(x@url,...),sep = " : ")
    cat("\n")

}
setMethod("print", "dspl_info", print.dspl_info )
setMethod("toString", "dspl_info", print.dspl_info )

setClass("dspl_topic",
    representation(
        id="character",
        info="dspl_info"
    ),
    prototype(
        info=new("dspl_info")
    )
)

setClass("dspl_table",
    representation(
        id="character",
        columns="vector",
        data="data.frame"
    ),
    prototype(
    )
) 

#Description : 
#Input       : 
#Output      : 
print.dspl_table <- function (x, terse=TRUE, ...) {
    cat("Table id: ",x@id,"\n")
    cat("Columns : ",cat(x@columns,sep=", "),"\n")
    if (terse==TRUE) {
        print(head(x@data))
    }
    else {
        print(x@data)
    }
}
setMethod("print", "dspl_table", print.dspl_table )
setMethod("toString", "dspl_table", print.dspl_table )

setClass("dspl_slice",
    representation(
        id="character",
        info="dspl_info",
        dimensions="vector",
        metrics="vector",
        table="character"
    ),
    prototype(
        info=new("dspl_info")
    )
) 

#Description : 
#Input       : 
#Output      : 
print.dspl_slice <- function (x, terse=TRUE, lang="en",...) {
    cat("Slice id: ",x@id,"\n")
    cat("Info: ",pms(x@info,lang=lang,...),"\n")
    cat("Dimensions [", length(x@dimensions), "]: ")
    for (d in x@dimensions) {
        cat (d, " ")
    }
    cat("\n")
    cat("Metrics [", length(x@metrics), "]: ")
    for (d in x@metrics) {
        cat (d, " ")
    }
    cat("\n")
    cat("Table: ",x@table)
}
setMethod("print", "dspl_slice", print.dspl_slice )
setMethod("toString", "dspl_slice", print.dspl_slice )

setClass("dspl_concept",
    representation(
        id="character",
        info="dspl_info",
        topics="vector",
        table="character"
    ),
    prototype(
        info=new("dspl_info"),
        topics=c(), 
        table=""
    )
) 

#Description : 
#Input       : 
#Output      : 
print.dspl_concept <- function (x, terse=TRUE, ...) {
    cat("Concept id: ", x@id,"\n")
    print(x@info,terse=terse,...)
    cat("Table id: ",x@table,"\n")

    cat("Topics  ",length(x@topics),sep=" : ")
    cat("  -  ")
    maxtopics = 5 
    cat(head(x@topics,maxtopics),sep= ", ")
    if (length(x@topics) > maxtopics) {
        y = length(x@topics) - maxtopics
        cat(" ... and",y,"more",sep=" ")
    }
    cat("\n")

}
setMethod("print", "dspl_concept", print.dspl_concept )
setMethod("toString", "dspl_concept", print.dspl_concept )

#Define a DSPL Class
setClass("dspl",
    representation(
        files="character",
        files.csv="character",
        files.xml="character",
        files.sqlite="character",
        path="character",
        info="dspl_info",
        provider="dspl_info",
        concepts="list",
        tables="list",
        slices="list",
        topics="list" #"data.frame"
    ),
    prototype(
        files=c(),
        files.csv=c(),
        files.xml="",
        files.sqlite="This feature not yet supported",
        path="",
        info=new("dspl_info"),
        concepts=list(),
        tables=list(),
        slices=list(),
        topics=list() #data.frame(row.names=c("id","parents","topic"))
    )
)


#Description : 
#Input       : 
#Output      : 
print.dspl <- function (x, terse=TRUE, lang="en", ...) {
    cat("DSPL Dataset - For more info see: [www.kidstrythisathome.com/dspl-r] \n")
    cat("------------                  or: [code.google.com/apis/publicdata/] \n\n")
    print(x@info,terse=terse,...)
    cat("\nProvider :",pms(x@provider@name,lang=lang), "[",x@provider@url,"]\n")
    if (terse==TRUE) {
        cat("Concepts",length(x@concepts),sep=" : ")
        cat("  -  ")
        maxconcepts = 5 
        cat(head(dspl.concepts.titles(x,lang),maxconcepts),sep= ", ")
        if (length(x@concepts) > maxconcepts) {
            y = length(x@concepts) - maxconcepts
            cat(" ... and",y,"more",sep=" ")
        }
        cat("\n")
        cat("Slices  ",length(x@slices),sep=" : ")
        cat("  -  ")
        maxslices = 5 
        cat(head(dspl.slices.titles(x,lang),maxslices),sep= ", ")
        if (length(x@slices) > maxslices) {
            y = length(x@slices) - maxslices
            cat(" ... and",y,"more",sep=" ")
        }
        cat("\n")
        cat("Tables  ",length(x@tables),sep=" : ")
        cat("  -  ")
        maxtables = 5 
        cat(head(dspl.tables(x,lang),maxtables),sep= ", ")
        if (length(x@tables) > maxtables) {
            y = length(x@tables) - maxtables
            cat(" ... and",y,"more",sep=" ")
        }
        cat("\n")
        cat("Topics  ",length(x@topics),sep=" : ")
        cat("  -  ")
        maxtopics = 5 
        cat(head(dspl.topics(x,lang),maxtopics),sep= ", ")
        if (length(x@topics) > maxtopics) {
            y = length(x@topics) - maxtopics
            cat(" ... and",y,"more",sep=" ")
        }
        cat("\n")
    }
    else {
    }
}
setMethod("print", "dspl", print.dspl)
setMethod("toString", "dspl", print.dspl)

#Description : Prints infromation about the provider of the dataset
#Input       : 
#Output      : 
dspl.provider <- function (dspl, lang="en") {
    cat("Name: ",pms(x@provider@name,lang=lang), " [",x@provider@url,"]\nDescription: ", pms(x@provider@description), sep="")
}

#Description : 
#Input       : 
#Output      : 
dspl.concepts <- function (dspl,lang="en", topic=NULL, id=NULL) {
    out = c()
    if (is.null(topic) & is.null(id)) {
        for (i in dspl@concepts) {
            out <- append(out,i)
        }
    }
    else if (! is.null(topic)) {
        topic_id = ""
        #Assume topic names are unique per language
        for (i in dspl@topics) {
            if (i@info@name[lang] == topic) {
                topic_id = i@id
            }
        }
        for (i in dspl@concepts) {
            for (j in i@topics) {
                if (i@topics == topic_id) {
                    out <- append(out,i)
                }
            }
        }
    }
    else if (! is.null(id)) {
        out = dspl@concepts[id][[1]]
    }
    out
}

#Description : 
#Input       : 
#Output      : 
dspl.concepts.titles <- function (dspl, lang="en") {
    out = c()
    for (i in dspl@concepts) {
        out <- append(out,pms(i@info@name,lang))
    }
    out
}

#Description : 
#Input       : 
#Output      : 
dspl.slices <- function (dspl, ...) {
    dspl@slices
}

#Description : 
#Input       : 
#Output      : 
dspl.slices.titles <- function (dspl,lang="en") {
    cs = c()
    for (i in dspl@slices) {
        if(is.na(i@info@name)) {
            cs <- append(cs,i@id)
        } else {
            cs <- append(cs,pms(i@info@name,lang))
        }
    }
    cs
}

#Description : 
#Input       : 
#Output      : 
dspl.slice.data <- function (dspl,id) {
    slice = dspl@slices[id][[1]]
    tbl_id = slice@table
    data = dspl@tables[tbl_id][[1]]@data
    cols = dspl@tables[tbl_id][[1]]@columns
    for (i in c(1:length(slice@dimensions))) {
        data[cols[i]] = factor(data[cols[i]][[1]])
    }
    data
}

#Description : 
#Input       : 
#Output      : 
dspl.tables <- function (dspl,lang="en") {
    cs = c()
    for (i in dspl@tables) {
        cs <- append(cs,i@id)
    }
    cs
}

#Description : 
#Input       : 
#Output      : 
dspl.topics <- function (dspl,lang="en") {
    cs = c()
    for (i in dspl@topics) {
        cs <- append(cs,pms(i@info@name,lang))
    }
    cs
}

#Description : 
#Input       : 
#Output      : 
dspl.concept.data <- function (dspl, concept=concept, ...) {
    dspl@tables[dspl@concepts[concept][[1]]@table][[1]]@data
}


#Description : 
#Input       : 
#Output      : 
prep.dspl <- function(filename) {
    #get the filename 
    file <- sub( ".*\\/","",filename)        
    #make a dir with the files name in a temporary location
    path <- paste(tempdir(),file,sep="/")
    unzip(filename, exdir=path)
    
    files <- dir(path)

    d <- new("dspl",
        path=path,
        files=files,
        files.csv=files[grep("\\.csv$",files)],
        files.xml=files[grep("\\.xml$",files)]
       )
    
    doc <- xmlParse(paste(d@path, d@files.xml,sep="/"))

    d@info     <- prep.dspl.info(xmlElementsByTagName(xmlRoot(doc), "info")$info)
    d@provider <- prep.dspl.info(xmlElementsByTagName(xmlRoot(doc), "provider")$provider)

    # If there are topics process them
    if (length(xmlElementsByTagName(xmlRoot(doc), "topics")) > 0) {
        d@topics   <- prep.dspl.topics(xmlElementsByTagName(xmlRoot(doc), "topics")$topics)
    }
    d@concepts <- prep.dspl.concepts(xmlElementsByTagName(xmlRoot(doc), "concepts")$concepts)
    d@tables   <- prep.dspl.tables(xmlElementsByTagName(xmlRoot(doc), "tables")$tables,path=path)
    d@slices   <- prep.dspl.slices(xmlElementsByTagName(xmlRoot(doc), "slices")$slices,path=path)

    d
}

#takes a filename returns a dspl_metadata class instance

#Description : 
#Input       : 
#Output      : 
prep.dspl.metadata <- function(path,file) {
    md <- new("dspl_metadata"
       )
    md
}


#Description : 
#Input       : 
#Output      : 
strip.whitespace <- function (text) {
    text <- gsub("[ \\t]*$","",text)
#    text <- gsub("^*[ \\t]","",text)
}

#takes an XML Info node and returns a dspl_info class instance

#Description : 
#Input       : 
#Output      : 
prep.dspl.info <-function(info) {
    i <- new("dspl_info",
        name = prep.dspl.multilingual_string(xmlElementsByTagName(info, "name")$name)
       )

    if (length(xmlElementsByTagName(info,"description"))>0) {
        i@description = prep.dspl.multilingual_string(xmlElementsByTagName(info, "description")$description)
    }

    if (length(xmlElementsByTagName(info,"url"))>0) {
        i@url = prep.dspl.multilingual_string(xmlElementsByTagName(info, "url")$url)
    }

#    for (i in xmlElementsByTagName(value, "value")) {
#        lang <- xmlAttrs(i)["lang"]
#        string <- toString.XMLNode(xmlChildren(i)$text)
#        
#        v[lang] = string
#        #v = append(v,new("multilingual_string",value=string,language=lang))
#    }
    
    i
}


#Description : 
#Input       : 
#Output      : 
prep.dspl.multilingual_string <- function(value) {
    v = c()
    for (i in xmlElementsByTagName(value, "value")) {
        lang <- xmlAttrs(i)["lang"]
        string <- toString.XMLNode(xmlChildren(i)$text)
        
        #v = append(v,new("multilingual_string",value=string,language=lang))
        v[lang] = strip.whitespace(string)
    }

    v
}

#recursively go through and build a flat list of topics

#Description : 
#Input       : 
#Output      : 
prep.dspl.topics <-function(topics,root=TRUE) {

    ids = c()
    topics_list <- c()
    if (!root) {
        x <- xmlElementsByTagName(topics,"info")$info
        x <- prep.dspl.info(x)

        id  <- paste(xmlAttrs(topics)["id"])
        ids <- append(ids,id)

        x = new("dspl_topic", id=id, info=x)
        topics_list <- append(topics_list,x)
    }

    if (length(xmlElementsByTagName(topics,"topic"))>0) {
        topics <- xmlElementsByTagName(topics, "topic")
        for (i in topics) {
            topics_list = append(topics_list, c(prep.dspl.topics(i,root=FALSE)))
        }
    }
    
    names(topics_list) <- ids
    topics_list
}


#Description : 
#Input       : 
#Output      : 
prep.dspl.concepts <- function(concepts) {

    cons <- c()
    ids = c()
    for (i in xmlElementsByTagName(concepts,"concept")) {
        id   <- paste(xmlAttrs(i)["id"])
        ids <- append(ids,id)
        x <- xmlElementsByTagName(i,"info")$info
        info <- prep.dspl.info(x)

        table <- xmlElementsByTagName(i,"table")$table

        topics = c()
        for (j in xmlElementsByTagName(i,"topic")) {
            topics <- append(topics, paste(xmlAttrs(j)["ref"]))
        }
        if (is.null(topics)) {
            topics=list()
        }

        if (!is.null(table)) {
            table <- paste(xmlAttrs(table)["ref"])
        }
        else {
            table = ""
        }

        c = new("dspl_concept",id=id,info=info,table=table,topics=topics)

        cons <- append(cons,c)
    }
    
    names(cons) = ids
    cons
}



#Description : 
#Input       : 
#Output      : 
prep.dspl.tables <- function(tables,path) {

    ts <- c()
    ids = c()
    for (table in xmlElementsByTagName(tables,"table")) {
        id   <- paste(xmlAttrs(table)["id"])
        ids <- append(ids,id)
        cols = NULL
        for (j in xmlElementsByTagName(table,"column")) {
            cols <- append(cols, paste(xmlAttrs(j)["id"]))
        }

        data <- xmlElementsByTagName(table,"data")$data
        if (!is.null(xmlElementsByTagName(data,"file"))) {
            data <- toString.XMLNode(xmlChildren(xmlElementsByTagName(data,"file")$file)$text)
            data <- gsub("[ \\t]*$","",data)
            data <- gsub("^[ \\t]*","",data)
            data <- read.csv(paste(path,data,sep="/"), header=TRUE)
        }

        t = new("dspl_table",id=id,columns=cols,data=data)

        ts <- append(ts,t)
    }
    
    names(ts) = ids
    ts
}



#Description : 
#Input       : 
#Output      : 
prep.dspl.slices <- function(slices,path) {

    ts <- c()
    ids <- c()
    for (slice in xmlElementsByTagName(slices,"slice")) {
        id   <- paste(xmlAttrs(slice)["id"])
        ids <- append(ids,id)

        info <- xmlElementsByTagName(slice,"info")
        if (length(info) > 0) {
            
        } else {
            info <- new('dspl_info',name=NA)
        }

        dims = NULL
        for (j in xmlElementsByTagName(slice,"dimension")) {
            dims <- append(dims, paste(xmlAttrs(j)["concept"]))
        }
        mets = NULL
        for (j in xmlElementsByTagName(slice,"metric")) {
            mets <- append(mets, paste(xmlAttrs(j)["concept"]))
        }

        table <- xmlElementsByTagName(slice,"table")$table
        table <- paste(xmlAttrs(table)['ref'])

        t = new("dspl_slice",
            id=id,
            info=info,
            dimensions=dims,
            metrics=mets,
            table=table
           )

        ts <- append(ts,t)
    }
    
    names(ts) = ids
    ts
}

#prep.dspl.topics <-function(topics,parents=c()) {
#
#    topics_list <- data.frame(row.names=c("id","parents"))
##    print(topics)
#    if (length(parents) > 0) {
#        x <- xmlElementsByTagName(topics, "topic")$topic
##        print(x)
#        x <- xmlElementsByTagName(topics,"info")$info
#        x <- prep.dspl.info(x)
#
#        id   <- paste(xmlAttrs(topics)["id"])
#
#        x <- data.frame(id=id,parents=parents,topic=x)
#        topics_list <- rbind(topics_list,x)
#
#        parents <- append(id,parents)
#    } else {
#        parents <- "_"
#    }
#
#    if (length(xmlElementsByTagName(topics,"topic"))>0) {
#        topics <- xmlElementsByTagName(topics, "topic")
#        for (i in topics) {
#            topics_list = rbind(topics_list, c(prep.dspl.topics(i,parents)))
#        }
#    }
#    
#    print(is(topics_list))
#    topics_list
#}
